home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / MISCCORE.INC < prev    next >
Text File  |  1994-02-17  |  38KB  |  1,545 lines
  1.  
  2. {section  AddBackSlash }
  3. Function  AddBackSlash(s1 : string) : string;
  4. var s : string;
  5.      begin
  6.      if (length(s1) > 0) and (s1[length(s1)] <> '\') then s := s1 + '\'
  7.      else s := s1;
  8.      AddBackSlash := s;
  9.      end;
  10.  
  11.  
  12. {section  BooleanStr }
  13. Function  BooleanStr( B : boolean ) : string;
  14. var S : string[5];
  15.     begin
  16.     if B then
  17.          BooleanStr := 'YES'
  18.     else BooleanStr := 'NO ';
  19.     end;
  20.  
  21.  
  22. {section  BreakLine }
  23. Function  BreakLine(var s : string; bklen : integer) : string;
  24. var s1 : string;
  25.     ll  : integer;
  26.     done : boolean;
  27.      begin
  28.      RemoveTrailing(s,' ');
  29.      s1 := s;
  30.      if length(s) > bklen then
  31.           begin
  32.           ll := bklen;
  33.           done := false;
  34.           while (ll > 0) and not done do
  35.                begin
  36.                if      s[ll] = ' ' then done := true
  37.                else if s[ll] = ',' then done := true
  38.                else dec(ll);
  39.                end;
  40.           if ll > 1 then
  41.                begin
  42.                s1 := copy(s,1,ll);
  43.                delete(s,1,ll);
  44.                end
  45.           else begin
  46.                s1 := copy(s,1,bklen);
  47.                delete(s,1,bklen);
  48.                end;
  49.           end
  50.      else s := '';
  51.      Breakline := s1;
  52.      end;
  53.  
  54.  
  55. {section  BreakLineChr }
  56. Function  BreakLineChr(var s : string; bklen : integer; ch : char) : string;
  57. var s1 : string;
  58.     ll  : integer;
  59.     done : boolean;
  60.      begin
  61.      RemoveTrailing(s,' ');
  62.      s1 := s;
  63.      if length(s) > bklen then
  64.           begin
  65.           ll := bklen;
  66.           done := false;
  67.           while (ll > 0) and not done do
  68.                begin
  69.                if      s[ll] = ch then done := true
  70.                else dec(ll);
  71.                end;
  72.           if ll > 1 then
  73.                begin
  74.                s1 := copy(s,1,ll);
  75.                delete(s,1,ll);
  76.                end
  77.           else begin
  78.                s1 := copy(s,1,bklen);
  79.                delete(s,1,bklen);
  80.                end;
  81.           end
  82.      else s := '';
  83.      BreakLineChr := s1;
  84.      end;
  85.  
  86.  
  87. {SECTION Buf16ToHexStr }
  88. Function Buf16ToHexStr(addr : longint; count : integer; var xbuf; flag : boolean) : string;
  89.             {[STRING] One line of the DUMP output}
  90. var s,asc : string;
  91.     i,j   : integer;
  92.     buf   : array[1..16] of byte;
  93.      begin
  94.      s := ''; asc := '';
  95.      move(xbuf,buf,16);
  96.      j := 16;
  97.      if count < 16 then j := count;
  98.      if count < 1  then j := 1;
  99.      for i := 1 to j do
  100.           begin
  101.           s := s + ByteToHex(buf[i]) + ' ';
  102.           if buf[i] > 31 then asc := asc + chr(buf[i])
  103.           else asc := asc + '.';
  104.           end;
  105.      Buf16ToHexStr := FmtAddress(addr,6,flag)+': '+ leftstr(s,48) +
  106.                                  ' | ' + asc;
  107.      end;
  108.  
  109.  
  110. {section  ByteToHex }
  111. Function  ByteToHex( B : byte) : string;
  112. var s : string[2];
  113.     b1 : byte;
  114.      begin
  115.      s := '00';
  116.      b1 := (b and $F0) div 16;
  117.      if b1 < 10 then s[1] := chr(b1+48)
  118.      else s[1] := chr(b1+55);
  119.      b1 := b and $0F;
  120.      if b1 < 10 then s[2] := chr(b1+48)
  121.      else s[2] := chr(b1+55);
  122.      ByteToHex := s;
  123.      end;
  124.  
  125.  
  126. {section CenterStr }
  127. Function CenterStr(s : string; w : byte) : string;
  128. { Centers a string in a field of specified width }
  129. var NewStr : string;
  130.     i       : word;
  131.     p       : word;
  132.      begin
  133.      FillChar(NewStr, SizeOf(NewStr), ' ');
  134.      NewStr[0] := CHR(w);
  135.      p         := (w - length(s)) SHR 1;
  136.      for i := 1 to length(s) do NewStr[p + i] := s[i];
  137.      CenterStr := NewStr
  138.      end;
  139.  
  140.  
  141. {SECTION  Compare }
  142. Function  Compare(s1,s2 :string) : boolean;
  143.                         {[STRING] Compares s1 to s2 - s2 can have wildcards }
  144. var i    : integer;
  145.     done : boolean;
  146.     ch   : char;
  147.      begin
  148.     { writeln('Compare  [',s1,'] [',s2,']');}
  149.      Compare := true; i := 0; done := false;
  150.      while (i < length(s2)) and not done do
  151.           begin
  152.           inc(i);
  153.           ch := s2[i];
  154.           case ch of
  155.                '?'   : begin end;   {match fine}
  156.                '*'   : begin Compare := true; done := true; end;
  157.                else    begin
  158.                        if s1[i] <> ch then
  159.                             begin
  160.                            { writeln('char ',i,' ',s1[i],' ',ch); }
  161.                             Compare := false;
  162.                             done := true;
  163.                             end;
  164.                        end;
  165.                end;
  166.           end;
  167.      if not done and (i <> length(s1)) then
  168.           begin
  169.          { writeln('ending ',i,' ',length(s1)); }
  170.           Compare := false;
  171.           end;
  172.      end;
  173.  
  174.  
  175. {SECTION  CompareL }
  176. Function  CompareL(s1,s2 :string; len : integer) : boolean;
  177.                         {[STRING] Compares s1 to s2 for length len }
  178.      begin
  179.      CompareL := Compare(leftstr(s1,len),leftstr(s2,len));
  180.      end;
  181.  
  182.  
  183. {SECTION  CompareUpL }
  184. Function  CompareUpL(s1,s2 :string; len : integer) : boolean;
  185.                         {[STRING] Compares s1 to s2 for length len (s1,s2 shifted UP)}
  186.      begin
  187.      CompareUpL := Compare(UpCaseStr(leftstr(s1,len)),
  188.                            UpCaseStr(leftstr(s2,len)));
  189.      end;
  190.  
  191.  
  192. {section CompressStr }
  193. Function CompressStr(s1 : string) : string;
  194. var ls,j,rc : integer;
  195.     s,s2    : string;
  196.     ch      : char;
  197.     begin
  198.      S := S1;
  199.     ls := length(s);
  200.     if ls < 3 then
  201.         begin
  202.         CompressStr := s;
  203.         exit;
  204.         end;
  205.     s2 := '';
  206.     j := 1;
  207.     while j <= ls  do
  208.         begin
  209.         if (j > (ls-2)) or (s[j] <> s[j+1]) or (s[j] <> s[j+2]) then
  210.             s2 := s2 + s[j]
  211.         else
  212.             begin
  213.             ch := s[j];
  214.             inc(j);
  215.             rc := 0;
  216.             s2 := s2 + s[j];
  217.             while (j <= ls) and (s[j] = ch) do
  218.                 begin
  219.                 inc(rc);
  220.                 inc(j);
  221.                 end;
  222.             s2 := s2 + chr(160+rc);
  223.             if j <= ls then s2 := s2 + s[j];
  224.             end;
  225.         inc(j);
  226.         end;
  227.     CompressStr := s2;
  228.     end;
  229.  
  230.  
  231. {section  ConstStr }
  232. Function  ConstStr(C : Char; N : Integer) : string;
  233.     (* returns a string with N characters of value C *)
  234. var S : string;
  235.     begin
  236.     if N < 0 then N := 0;
  237.     S[0] := Chr(N);
  238.     FillChar(S[1],N,C);
  239.     ConstStr := s;
  240.     end;
  241.  
  242.  
  243.  
  244. {section  CopyRemove }
  245. Function  CopyRemove(var s : string; f,l : integer) : string;
  246.                             {[STRING] copies then deletes a substring }
  247. var len : integer;
  248.      begin
  249.      CopyRemove := '';
  250.      if (f > 0) and (f <= l) and (l <= length(s)) then
  251.           begin
  252.           len := (l - f) + 1;
  253.           CopyRemove := copy(s,f,len);
  254.           delete(s,f,len);
  255.           end;
  256.      end;
  257.  
  258.  
  259. {section  CurrDTimeString }
  260. Function  CurrDTimeString : string;
  261.     var
  262.         temp1,temp2       : string;
  263.         Yr, Mo, Da, dow   : word;
  264.         Hr, Mn, Sc, sc100 : word;
  265.         i                 : integer;
  266.         l                 : longint;
  267.     begin
  268.     GetDate(yr,mo,da,dow);
  269.     l := (yr-1900)*tenthousand + mo*onehundred +da;
  270.     str(l:6,temp1);
  271.     GetTime(hr,mn,sc,sc100);
  272.     l := hr*tenthousand + mn*onehundred +sc;
  273.     str(l:6,temp2);
  274.     for i := 1 to 6 do
  275.         begin
  276.         if temp1[i] = ' ' then temp1[i] := '0';
  277.         if temp2[i] = ' ' then temp2[i] := '0';
  278.         end;
  279.     CurrDTimeString := temp1+temp2;
  280.     end;
  281.  
  282.  
  283. {section  DefaultDriveStr }
  284. Function  DefaultDriveStr : string;
  285. var s : string;
  286.     begin
  287.     GetDir(0,s);
  288.     DefaultDriveStr := s;
  289.     end;
  290.  
  291.  
  292. {section  DeleteBackSlash }
  293. Function  DeleteBackSlash(s1 : string) : string;
  294. var s : string;
  295.      begin
  296.      if (length(s1) > 0) and (s1[length(s1)] = '\') then
  297.           s := copy(s1,1,length(s1)-1)
  298.      else s := s1;
  299.      DeleteBackSlash := s;
  300.      end;
  301.  
  302.  
  303. {section  DirTag }
  304. Function  DirTag(path : string) : string;
  305. var s : string;
  306.     i : integer;
  307.      begin
  308.      s := path;
  309.      i := pos('\',s);
  310.      while i > 0 do
  311.           begin
  312.           delete(s,1,i);
  313.           i := pos('\',s);
  314.           end;
  315.      Dirtag := s;
  316.      end;
  317.  
  318.  
  319. {section DnCaseStr }
  320. Function DnCaseStr(s : string) : string;
  321. { Converts a string to lower case characters }
  322. var i : integer;
  323.     b : byte;
  324.      begin
  325.      for i := 1 to length(s) do
  326.           begin
  327.           b := ord(s[i]);
  328.           if (b > 64) and (b < 91) then s[i] := chr(b+32);
  329.           end;
  330.      DnCaseStr := s;
  331.      end;
  332.  
  333.  
  334. {section DollarStr }
  335. Function DollarStr( R : real; L : integer ) : string;
  336. var S : string;
  337.     begin
  338.     S := '';
  339.     case L of
  340.         4..15  : Str(R:L:2,S);
  341.         else     S := ConstStr('*',L);
  342.         end;
  343.     DollarStr := s;
  344. end;
  345.  
  346.  
  347.  
  348. Function  DOSErrStr(err : integer) : string;
  349. { DOS file error returns }
  350. var s : string;
  351.      begin
  352.      case err of
  353.          0        : s :=  'ok ' ;
  354.          1        : s :=  'Invalid function number' ;
  355.          2        : s :=  'file not found' ;
  356.          3        : s :=  'Path not found' ;
  357.          4        : s :=  'Too many open files' ;
  358.          5        : s :=  'File access denied' ;
  359.          6        : s :=  'Invalid file handle' ;
  360.          12       : s :=  'Invalid file access code' ;
  361.          15       : s :=  'Invalid drive number' ;
  362.          18       : s :=  'No More files' ;
  363.          100      : s :=  'Disk read error' ;
  364.          101      : s :=  'Disk write error' ;
  365.          102      : s :=  'File not assigned' ;
  366.          103      : s :=  'File not open' ;
  367.          104      : s :=  'File not opened for input' ;
  368.          105      : s :=  'File not opened for output' ;
  369.          150      : s :=  'Disk is write protected' ;
  370.          152      : s :=  'drive not ready' ;
  371.          159      : s :=  'Printer out of paper' ;
  372.          160      : s :=  'Device write fault' ;
  373.          162      : s :=  'Hardware failure' ;
  374.          200      : s :=  'Division by zero' ;
  375.          201      : s :=  'Range check' ;
  376.          202      : s :=  'Stack overflow' ;
  377.          203      : s :=  'Heap overflow' ;
  378.          204      : s :=  'Invalid pointer operation' ;
  379.          205..207 : s := 'Floating point problem' ;
  380.          208..209 : s := 'Overlay problem' ;
  381.          210..214 : s := 'Object problem' ;
  382.          else       s := 'USER ERR ';
  383.          end;
  384.      DOSErrStr := 'DOS Error('+integerstr(err,4)+') '+s+'. ';
  385.      end;
  386.  
  387.  
  388. {section  DumpRecBufInHex }
  389. Procedure DumpRecBufInHex(recnum : longint; recsiz : integer; var rec);
  390.             {[DEBUG] Dumps a record buffer in HEX }
  391. var l,rs : longint;
  392.     rbuf : array[1..2048] of byte;
  393.     zbuf : array[1..16] of byte;
  394.     i,j  : integer;
  395.      begin
  396.      i := 1; rs := recsiz;
  397.      if rs > sizeof(rbuf) then rs := sizeof(rbuf);
  398.      fillchar(rbuf,sizeof(rbuf),0);
  399.      move(rec,rbuf,rs);
  400.      l := (recnum-1)*recsiz;
  401.      writeln('Record - ',recnum,'    size=',rs,
  402.              '    fileaddr:',l);
  403.      while i < recsiz do
  404.           begin
  405.           move(rbuf[i],zbuf,16);
  406.           writeln(Buf16ToHexStr(i,(recsiz-i),zbuf,false));
  407.           i := i + 16;
  408.           end;
  409.      if recsiz > 16 then writeln(' ');
  410.      end;
  411.  
  412.  
  413.  
  414. {section  EquivalentFile }
  415. Function  EquivalentFile(fn1,fn2 : string) : boolean;
  416. var same : boolean;
  417.     sr1, sr2 : searchrec;
  418.      begin
  419.      same := false;
  420.      if (fileInfo(fn1,'',sr1) = 0) and
  421.         (fileInfo(fn2,'',sr2) = 0) then
  422.           begin
  423.           if (sr1.size = sr2.size) and
  424.              (sr1.time = sr2.time) then same := true;
  425.           end;
  426.      EquivalentFile := same;
  427.      end;
  428.  
  429.  
  430. {section  EraseFile }
  431. Procedure EraseFile(s : string);
  432. var f : file;
  433.     ch : char;
  434.     begin
  435.     assign (f,s);
  436.     {$I-}
  437.     reset (f);
  438.     {$I+}
  439.     if IOResult = 0 then
  440.         begin
  441.         close(f);
  442.         Erase(f);
  443.         end;
  444.     end;
  445.  
  446.  
  447. {section  ExtractDelimitedStr }
  448. Function  ExtractDelimitedStr(var s : string; lchar,rchar : char) : string;
  449.                        {[STRING] extracts inside of a delimited substring }
  450. var i,j  : integer;
  451.     s1   : string;
  452.      begin
  453.      ExtractDelimitedStr :=  '';
  454.      i := pos(lchar,s);
  455.      if i > 0 then
  456.           begin
  457.           j := pos(rchar,s);
  458.           if (j > i) then
  459.                begin
  460.                s1 :=  CopyRemove(s,i,j);
  461.                delete(s1,1,1);
  462.                if length(s1) > 0 then delete(s1,length(s1),1);
  463.                ExtractDelimitedStr :=  s1;
  464.                end;
  465.           end;
  466.      end;
  467.  
  468.  
  469. {section ExtractPath }
  470. Function ExtractPath(var fname : string) : string;
  471. var i : integer;
  472.     npath : string;
  473.     begin
  474.     npath := '';
  475.     i := pos('\',fname);
  476.     while i > 0 do
  477.          begin
  478.          npath := npath + copy(fname,1,i);
  479.          delete(fname,1,i);
  480.          i := pos('\',fname);
  481.          end;
  482.     ExtractPath := npath;
  483.     end;
  484.  
  485.  
  486. {section FileDate }
  487. Function FileDate(fname : string; ext : string) : longint;
  488. var l : longint;
  489.     fn : string;
  490.     SR : searchrec;
  491.      begin
  492.      fn := fname;
  493.      l := 0;
  494.      if ext <> '' then ForceExt(fn,ext);
  495.      FindFirst(fn,anyfile,SR);
  496.      if dosError = 0 then l := SR.time;
  497.      FileDate := l;
  498.      end;
  499.  
  500.  
  501. {section FileExists }
  502. Function FileExists(FName : String) : boolean;
  503. var f     : file;
  504.     fAttr : word;
  505.      begin
  506.      assign(f, FName);
  507.      GetFAttr(f, fAttr);
  508.      FileExists := (DosError = 0)
  509.            and ((fAttr and Directory) = 0)
  510.            and ((fAttr and VolumeID)  = 0)
  511.      end;  { FileExists }
  512.  
  513.  
  514.  
  515. {section  FileExt }
  516. Function  FileExt(fname : string) : string;
  517. var i : integer;
  518.     ext : string[3];
  519.     begin    {doesn't use FSplit - maybe smaller }
  520.     ext := '';
  521.     i := pos('.',fname);
  522.     if i > 0 then ext := copy(fname,i+1,3);
  523.     FileExt := ext;
  524.     end;
  525.  
  526.  
  527. {section FileInfo }
  528. Function FileInfo(filespec : string; ext : string;
  529.                    var SR : searchrec) : integer;
  530. var fn : string;
  531.     err : integer;
  532.      begin
  533.      err := 0;
  534.      fn := filespec;
  535.      if ext <> '' then ForceExt(fn,ext);
  536.      FindFirst(fn,anyfile,SR);
  537.      FileInfo := dosError;
  538.      end;
  539.  
  540.  
  541. {section  FileExtStr }
  542. Function  FileExtStr(fname : string) : string;
  543. var dir,nam,ext : string;
  544.      begin
  545.      FSplit(fname,dir,nam,ext);
  546.      FileExtStr := ext;
  547.      end;
  548.  
  549.  
  550. {section  FilePathStr }
  551. Function  FilePathStr(fname : string) : string;
  552. var dir,nam,ext : string;
  553.      begin
  554.      FSplit(fname,dir,nam,ext);
  555.      FilePathStr := dir;
  556.      end;
  557.  
  558.  
  559. {section  FileRootStr }
  560. Function  FileRootStr(fname : string) : string;
  561. var dir,nam,ext : string;
  562.      begin
  563.      FSplit(fname,dir,nam,ext);
  564.      FileRootStr := nam;
  565.      end;
  566.  
  567.  
  568. {section FindAndReplaceStr }
  569. Function FindAndReplaceStr(str,fstr,rstr : string; both,all : boolean) : string;
  570.                  {[STRING] finds fstr replaces with rstr, options}
  571. var s,s1,f1s : string;
  572.     i,j    : integer;
  573.     ok : boolean;
  574.      begin
  575.      s   := str;
  576.      if both then
  577.           begin
  578.           f1s := UpCaseStr(fstr);
  579.           s1  := UpCaseStr(s);
  580.           end
  581.      else begin
  582.           f1s := fstr;
  583.           s1  := s;
  584.           end;
  585.      ok := true;
  586.      j := 0;
  587.      while ok do
  588.           begin
  589.           i := pos(f1s,s1);
  590.           if (i > 0) and (j < i) then    {recursion problem}
  591.                begin
  592.                j := i;
  593.                delete(s,i,length(f1s));
  594.                insert(rstr,s,i);
  595.                delete(s1,i,length(f1s));
  596.                insert(rstr,s1,i);
  597.                end
  598.           else ok := false;
  599.           if not all then ok := false;
  600.           if i > 200 then ok := false;  { by 'a' -> 'aa' }
  601.           end;
  602.      FindAndReplaceStr := s;
  603.      end;
  604.  
  605.  
  606. {SECTION FmtAddress }
  607. Function FmtAddress( a : longint; l : integer; flag : boolean) : string;
  608.           {[STRING] formats a longint optionally as hex - for DUMP }
  609. var s : string;
  610.     x : byte;
  611.      begin
  612.      if not Flag then
  613.           s := LongIntStr(a,l)
  614.      else begin
  615.           s := '  ';
  616.           x := byte(a div 256);
  617.           s := s + ByteToHex(x);
  618.           x := byte(a AND $FF);
  619.           s := s + ByteToHex(x);
  620.           end;
  621.      FmtAddress := s;
  622.      end;
  623.  
  624.  
  625.  
  626. {section FmtChr }
  627. Function FmtChr(b : byte) : string;
  628. var s : string[5];
  629.     begin
  630.     s := '<--->';
  631.     case b of
  632.         0..31, 127  : s := '<' + FmtCvtChr(b) + '>';
  633.         32..126     : s :=  chr(b);
  634.         160..254    : begin
  635.                       str(b:3,s);
  636.                       s := '<' + s + '>';
  637.                       end;
  638.        end;
  639.     FmtChr := s;
  640.     end;
  641.  
  642.  
  643. {section FmtCvtChr }
  644. Function FmtCvtChr(b : byte) : string;
  645. var s : string[3];
  646.     begin
  647.     s := '---';
  648.     case b of
  649.         0  : s := 'NUL';
  650.         1  : s := 'SOH';
  651.         2  : s := 'STX';
  652.         3  : s := 'ETX';
  653.         4  : s := 'EOT';
  654.         5  : s := 'ENQ';
  655.         6  : s := 'ACK';
  656.         7  : s := 'BEL';
  657.         8  : s := 'BS ';
  658.         9  : s := 'HT ';
  659.        10  : s := 'LF ';
  660.        11  : s := 'VT ';
  661.        12  : s := 'FF ';
  662.        13  : s := 'CR ';
  663.        14  : s := 'SO ';
  664.        15  : s := 'SI ';
  665.        16  : s := 'DLE';
  666.        17  : s := 'DC1';
  667.        18  : s := 'DC2';
  668.        19  : s := 'DC3';
  669.        20  : s := 'DC4';
  670.        21  : s := 'NAK';
  671.        22  : s := 'SYN';
  672.        23  : s := 'ETB';
  673.        24  : s := 'CAN';
  674.        25  : s := 'EM ';
  675.        26  : s := 'SUB';
  676.        27  : s := 'ESC';
  677.        28  : s := 'FS ';
  678.        29  : s := 'GS ';
  679.        30  : s := 'RS ';
  680.        31  : s := 'US ';
  681.        127 : s := 'DEL';
  682.        else  begin
  683.              if b > 31 then s := chr(b) + '  ';
  684.              end;
  685.        end;
  686.     FmtCvtChr := s;
  687.     end;
  688.  
  689.  
  690. {section  FmtHMS }
  691. Function  FmtHMS(hr, mn, sc : word) : string;
  692. var s : string[8];
  693.     l : longint;
  694.      begin
  695.      s := '        ';
  696.      l := (hr+100)*tenthousand + mn*onehundred +sc;
  697.      str(l:8,s);
  698.   {   if s[3] = '0' then s[3] := ' '; }
  699.      FmtHMS :=  s[3] + s[4] + ':' + s[5] + s[6] + ':' +  s[7] + s[8];
  700.      end;
  701.  
  702.  
  703. {section  FmtKstr }
  704. Function  FmtKstr(l : longint) : string;
  705. var s : string[10];
  706.      begin
  707.      s := '**';
  708.      str((l div $400),s);
  709.      FmtKstr := s + 'k';
  710.      end;
  711.  
  712.  
  713. {section  FmtKstrComma }
  714. Function  FmtKstrComma(l : longint) : string;
  715. var s : string;
  716.      begin
  717.      s := '**';
  718.      str((l div $400),s);
  719.      if length(s) > 3 then insert(',',s,length(s)-2);
  720.      FmtKstrComma := s + 'k';
  721.      end;
  722.  
  723.  
  724. {section FmtStr }
  725. Function FmtStr(s : string) : string;
  726. var s1 : string;
  727.     i : integer;
  728.      begin
  729.      s1 := '';
  730.      if length(s) > 0 then for i := 1 to length(s) do
  731.           begin
  732.           s1 := s1 + FmtChr(ord(s[i]));
  733.           end;
  734.      fmtStr := s1;
  735.      end;
  736.  
  737.  
  738. {section  FmtYMD }
  739. Function  FmtYMD(Yr, Mo, Da : word) : string;
  740. var s : string;
  741.     l : longint;
  742.      begin
  743.      l := yr*tenthousand + mo*onehundred +da;
  744.      str(l:8,s);
  745.      if s[5] = '0' then s[5] := ' ';
  746.      FmtYMD :=  s[5] + s[6] + '/' + s[7] + s[8] + '/' +  s[3] + s[4];
  747.      end;
  748.  
  749.  
  750. {section  ForceExt }
  751. Procedure ForceExt(var fname : string; ext : string);
  752. var i : integer;
  753.     begin
  754.     i := pos('.',fname);
  755.     if i > 0 then fname := copy(fname,1,i-1);
  756.     if ext[1] = '.' then fname := fname + ext
  757.     else fname := fname + '.' + ext;
  758.     end;
  759.  
  760.  
  761. {section  ForcePath }
  762. Procedure ForcePath(var fname : string; path : string);
  763. var i : integer;
  764.     npath : string;
  765.     begin
  766.     npath := ExtractPath(fname); { take out path and throw away}
  767.     npath := path;
  768.     if path = '' then
  769.          begin
  770.          getdir(0,npath);
  771.          npath := addbackslash(defaultdrivestr)+npath;
  772.          end;
  773.     fname := addbackslash(path) + fname;
  774.     end;
  775.  
  776.  
  777.  
  778. {section ForceRenameFile }
  779. Function ForceRenameFile(fname1,fname2 : string) : boolean;
  780.                   {[FILE] Erases file 2 first. }
  781.      begin
  782.      ForceRenameFile := false;
  783.      EraseFile(fname2);
  784.      if RenameFile(fname1,fname2) then ForceRenameFile := true;
  785.      end;
  786.  
  787.  
  788. {section ForceRenameToBak }
  789. Function ForceRenameToBAK(fname : string) : boolean;
  790. var fn1 : string;
  791.      begin
  792.      ForceRenameToBAK := true;
  793.      fn1 := fname;
  794.      ForceExt(fn1,'BAK');
  795.      if not ForceRenameFile(fname,fn1) then
  796.           begin
  797.           ForceRenameToBAK := false;
  798.           writeln('unable to rename [',fname,']  to [',fn1,']');
  799.           end;
  800.      end;
  801.  
  802.  
  803. {section  FormatDTime }
  804. Function  FormatDTime : string;
  805. var Yr, Mo, Da, dow   : word;
  806.     Hr, Mn, Sc, sc100 : word;
  807. var temp : string;
  808.     begin
  809.     GetDate(yr,mo,da,dow);
  810.     GetTime(hr,mn,sc,sc100);
  811.     FormatDTime :=  FmtYMD(yr,mo,da) + ' ' + FmtHMS(hr,mn,sc);
  812.     end;
  813.  
  814.  
  815. {section GetNumber }
  816. Function GetNumber( var astring : string) : real;
  817. var x       : real;
  818.     bstring : string;
  819.     error   : integer;
  820.     begin
  821.     x := 0;
  822.     bstring := GetString(astring);
  823.     if length(bstring) > 0 then
  824.         begin
  825.         val(bstring,x,error);
  826.         if (error <> 0) then
  827.             writeln(' val conversion error  * ',bstring,' *  ',error);
  828.         end;
  829.     GetNumber := x;
  830.     end;
  831.  
  832.  
  833.  
  834. {section  GetSTring }
  835. Function  GetString ( var s : string) : string;
  836. var s1 : string;
  837.     i,l     : integer;
  838.      begin
  839.      i := pos(',',s);
  840.      if i > 0 then
  841.           begin
  842.           GetString := copy(s,1,i-1);
  843.           delete(s,1,i);
  844.           end
  845.      else begin
  846.           GetString := s;
  847.           s := '';
  848.           end;
  849.      end;
  850.  
  851.  
  852.  
  853. {section  HexAddressToLongInt }
  854. Function  HexAddressToLongInt(s : string) : longint;
  855. var l1,l2,l : longint;
  856.     s1,s2 : string[5];
  857.     i    : integer;
  858.      begin
  859.      i := pos(':',s);
  860.      if i > 0 then
  861.           begin
  862.           s1 := copy(s,1,i-1);
  863.           s2 := copy(s,i+1,length(s)-i);
  864.           end
  865.      else begin
  866.           s1 := '';
  867.           s2 := s;
  868.           end;
  869.      l1 := hextolongint(s1);
  870.      l2 := hextolongint(s2);
  871.    {  writeln('hexaddresstolongint [',s1,'] [',s2,'] ',l1,'  ',l2);}
  872.      HexAddressToLongInt := (l1 * 16) + l2;
  873.      end;
  874.  
  875.  
  876. {section  HexToByte }
  877. Function  HexToByte( st : string) : byte;
  878. var  s     : string[3];
  879.      b1,b2     : byte;
  880.      begin
  881.      HexToByte := 0;
  882.      s := st;
  883.      if s[1] = '$' then delete(s,1,1);
  884.      if length(s) < 2 then exit;
  885.      if ord(s[1]) < ord('A') then b1 := ((ord(s[1])-48)and $F)
  886.      else b1 := ((ord(s[1])-55) and $F);
  887.      if ord(s[2]) < ord('A') then b2 := ((ord(s[2])-48)and $F)
  888.      else b2 := ((ord(s[2])-55) and $F);
  889.      HexToByte := (b1 * 16) + b2;
  890.      end;
  891.  
  892.  
  893. {section  HexToLongInt }
  894. Function  HexToLongInt(s : string) : longint;
  895. var l1,l : longint;
  896.     ll   : byte;
  897.     s1   : string[6];
  898.     nibble : string;
  899.      begin
  900.      s1 := s;
  901.      ll := length(s1);
  902.      if (ll div 2) * 2 <> ll then s1 := '0' + s1;
  903.      l  := 0;
  904.      while length(s1) > 0 do
  905.           begin
  906.           nibble := s1;
  907.           delete(s1,1,2);
  908.           l1 := hextobyte(nibble);
  909.           l := l * $100 + l1;
  910.           end;
  911.      HexToLongInt := l;
  912.      end;
  913.  
  914.  
  915. {section  Int2Real }
  916. Function  Int2Real(i : Integer) : real;
  917. var y     : real;
  918.      begin
  919.      y := i;
  920.      Int2Real := y / 8.0;
  921.      end;
  922.  
  923.  
  924. {section IntegerStr }
  925. Function IntegerStr( I : integer; L : integer ) : string;
  926. var S : string;
  927.     begin
  928.     Str(I,S);
  929.     IntegerStr := RightStr(S,L);
  930.     end;
  931.  
  932.  
  933. {section LeftStr }
  934. Function LeftStr( St : string; L : integer ) : string;
  935.      begin
  936.      LeftStr := copy(St+conststr(' ',L-length(St)),1,l);
  937.      end;
  938.  
  939.  
  940. {section LJStr }
  941. Function LJStr(s : string; w : byte) : string;
  942.            {[STRING] Left justifies a string in a field of specified width }
  943. var NewStr : string;
  944.      begin
  945.      FillChar(NewStr, SizeOf(NewStr), ' ');
  946.      NewStr    := s;
  947.      NewStr[0] := CHR(w);
  948.      LJStr     := NewStr
  949.      end;
  950.  
  951.  
  952. {section  LongIntStr }
  953. Function  LongIntStr( I : longint; L : integer ) : string;
  954. var S : string;
  955.     begin
  956.     Str(I,S);
  957.     LongintStr := RightStr(S,L);
  958.     end;
  959.  
  960.  
  961.  
  962. {section MergeStr }
  963. Function MergeStr( s : string; posn : integer; s1 : string) : string;
  964. var i,j,n,p : integer;
  965.     st      : string;
  966.     begin
  967.     st := s;
  968.     p := posn;
  969.     if p < 1 then p := 1;
  970.     if (p > 253) then exit;
  971.     i := length(s1);
  972.     n := p+i-1;
  973.     if n > 253 then i := 253 - n;
  974.     if n > length(st) then st := leftstr(st,n);
  975.     move(s1[1],st[p],i);
  976.     Mergestr := st;
  977.     end;
  978.  
  979.  
  980. {section MIN }
  981. Function Min(i1,i2 : integer) : integer;
  982.      begin
  983.      if i1 < i2 then min := i1
  984.      else min := i2;
  985.      end;
  986.  
  987.  
  988. {section  MiscDelayNTicks }
  989. Procedure MiscDelayNTicks(n : longint);
  990.       {[DATETIME] A delay of 1 seems to be about 0.05 seconds}
  991. var j : integer;
  992.     t : longint;
  993.      begin
  994.      if n = 0 then exit;
  995.      for j := 1 to n do
  996.           begin
  997.           t := TicksSinceMidnight;
  998.           while TicksSinceMidnight = t do begin end;
  999.           end;
  1000.      end;
  1001.  
  1002.  
  1003. {section  NumericsOnlyStr }
  1004. Function  NumericsOnlyStr(s : string) : string;
  1005. var i  : integer;
  1006.     s1 : string;
  1007.      begin
  1008.      s1 := '';
  1009.      if length(s) > 0 then
  1010.           begin
  1011.           for i := 1 to length(s) do
  1012.               if s[i] in ['0'..'9','-'] then s1 := s1 + s[i];
  1013.           end;
  1014.      NumericsOnlyStr := s1;
  1015.      end;
  1016.  
  1017.  
  1018.  
  1019. {section  PackTimeStr }
  1020. Function  PackTimestr(PT : longint) : string;
  1021. var d : DateTime;  { DOS }
  1022. var temp : string[14];
  1023.     begin
  1024.     UnPackTime(PT,d);
  1025.     temp :=  FmtYMD(d.year,d.month,d.day) + ' ' +
  1026.                     FmtHMS(d.hour,d.min,d.sec);
  1027.     PackTimestr := temp;
  1028.     end;
  1029.  
  1030.  
  1031. {section  PatchStr }
  1032. Procedure PatchStr(var s : string; ch1,ch2 : char);
  1033. var i : integer;
  1034.     begin
  1035.     i := 1;
  1036.     while i <= length(s) do
  1037.          begin
  1038.          if s[i] = ch1 then s[i] := ch2;
  1039.          inc(i);
  1040.          end;
  1041.     end;
  1042.  
  1043.  
  1044. {section PctStr }
  1045. Function PctStr(x,y : real; L,D : integer) : string;
  1046. var s : string;
  1047.     z : real;
  1048.      begin
  1049.      z := (x/(y+0.00001)) * 100;
  1050.      if z > 9999 then z := 9999;
  1051.      s := realstr(z,L,D);
  1052.      PctStr := s + '%';
  1053.      end;
  1054.  
  1055.  
  1056. {section ProperName }
  1057. Function ProperName(s : string) : string;
  1058. { Converts a string to lower case characters and capitalizes first letter}
  1059. var i : integer;
  1060.     b : byte;
  1061.      begin
  1062.      s := DnCaseStr(s);
  1063.      s[1] := Upcase(s[1]);
  1064.      ProperName := s;
  1065.      end;
  1066.  
  1067.  
  1068. {section  QT }
  1069. Function  QT(s : string) : string;    { makes a string with quotes around it }
  1070.      begin
  1071.      QT := '''' + s + '''';
  1072.      end;
  1073.  
  1074.  
  1075. {section Real2Int }
  1076. Function Real2Int(x : real) : Integer;
  1077. { pack reals in range -4095 to +4095 to an integer }
  1078. { resolution is to 1/8                             }
  1079. var y     : real;
  1080.     l     : longint;
  1081.      begin
  1082.      Real2Int := 0;
  1083.      l := abs(trunc(x*8));
  1084.      if (l > 32760) then l := 32760;
  1085.      if x < 0 then l := -1 * l;
  1086.      Real2Int := l;
  1087.      end;
  1088.  
  1089.  
  1090. {section RealStr }
  1091. Function RealStr( R : real; L,D : integer ) : string;
  1092. var S : string;
  1093.     begin
  1094.     Str(R:12:D,S);
  1095.     RealStr := RightStr(S,L);
  1096.     end;
  1097.  
  1098.  
  1099. {section RealZero }
  1100. Function RealZero( x : real) : boolean;
  1101.      begin
  1102.      if abs(x) < 0.01 then RealZero := true
  1103.      else RealZero := false;
  1104.      end;
  1105.  
  1106.  
  1107. {section  RemoveBlanks }
  1108. Procedure RemoveBlanks(var astring : string);
  1109. var j : integer;
  1110.     begin
  1111.     j := 1;
  1112.     while j <= length(astring) do
  1113.         begin
  1114.         if (astring[j] = ' ') then delete(astring,j,1)
  1115.         else inc(j);
  1116.         end;
  1117.     end;
  1118.  
  1119.  
  1120. {section RemoveBrackets }
  1121. Function RemoveBrackets(s : string) : string;
  1122. var len : integer;
  1123.     s1  : string;
  1124.     begin
  1125.     len := length(s);
  1126.     s1  := trimstr(s);
  1127.     if len > 2 then
  1128.          begin
  1129.          case s1[1] of
  1130.              '[' :  begin
  1131.                     if s1[len] = ']'   then RemoveEnds(s1);
  1132.                     end;
  1133.              '{' :  begin
  1134.                     if s1[len] = '}'   then RemoveEnds(s1);
  1135.                     end;
  1136.              '(' :  begin
  1137.                     if s1[len] = ')'   then RemoveEnds(s1);
  1138.                     end;
  1139.              '''' : begin
  1140.                     if s1[len] = ''''  then RemoveEnds(s1);
  1141.                     end;
  1142.              '"'  : begin
  1143.                     if s1[len] = '"'   then RemoveEnds(s1);
  1144.                     end;
  1145.              '<'  : begin
  1146.                     if s1[len] = '>'   then RemoveEnds(s1);
  1147.                     end;
  1148.              else   begin end;
  1149.              end;
  1150.          end;
  1151.      RemoveBrackets := s1;
  1152.      end;
  1153.  
  1154.  
  1155. {section  RemoveEnds }
  1156. Procedure RemoveEnds(var s : string);
  1157.      begin
  1158.      if length(s) < 2 then exit;
  1159.      delete(s,1,1);
  1160.      delete(s,length(s),1);
  1161.      end;
  1162.  
  1163.  
  1164. {section  RemoveExcessBlanks }
  1165. Procedure RemoveExcessBlanks(var astring : string);
  1166. var prev : char;
  1167.     j    : integer;
  1168.     begin
  1169.     prev := ' ';
  1170.     j := length(astring);
  1171.     if j > 0 then
  1172.         begin
  1173.         j := 1;
  1174.         repeat
  1175.             begin
  1176.             if (astring[j] = ' ') and (prev = ' ') then delete(astring,j,1)
  1177.             else
  1178.                 begin
  1179.                 prev := astring[j];
  1180.                 j := j + 1;
  1181.                 end;
  1182.             end;
  1183.         until j > length(astring);
  1184.         end;
  1185.     end;
  1186.  
  1187.  
  1188. {section  RemoveLeading }
  1189. Procedure RemoveLeading(var s : string; ch : CHAR);
  1190. var i,l : integer;
  1191. { Remove specified leading characters from string }
  1192.      begin
  1193.      i := 1;
  1194.      l := length(s)+1;
  1195.      while (i < l) and (s[i] = ch) do inc(i);
  1196.      if i > 1 then delete(s, 1, i-1);
  1197.      end;
  1198.  
  1199.  
  1200. {section  RemoveLeading }
  1201. Procedure RemoveLeadingTUG(var s : string; ch : CHAR);
  1202. { Remove specified leading characters from string }
  1203.      begin
  1204.      while (length(s) > 0) and (s[1] = ch) do
  1205.           delete(s, 1, 1)
  1206.      end;
  1207.  
  1208.  
  1209. {section  RemoveTrailing }
  1210. Procedure RemoveTrailing(var s : string; ch : CHAR);
  1211. { Remove specified trailing characters from string }
  1212.      begin
  1213.      while (length(s) > 0) and (s[length(s)] = ch) do
  1214.             s[0] := chr(ord(s[0]) - 1)
  1215.      end;
  1216.  
  1217.  
  1218.  
  1219. {section RenameFile }
  1220. Function RenameFile(fname1,fname2 : string) : boolean;
  1221.                   {[FILE] Returns false if fails. }
  1222. var fil : file;
  1223.     err : integer;
  1224.      begin
  1225.      RenameFile := false;
  1226.      assign(fil,fname1);
  1227.      {$I-} rename(fil,fname2); {$I+}
  1228.      err := IOResult;
  1229.      if err = 0 then RenameFile := true
  1230.      else writeln('RenameFile error ',err);
  1231.      {$I-} close(fil); {$I+}
  1232.      err := IOResult;  {ignore error on close}
  1233.      end;
  1234.  
  1235.  
  1236. {section  ReplaceStr }
  1237. Procedure ReplaceStr( var Str : string; Offset : integer; S1 : string);
  1238.      begin
  1239.      Str := Str + conststr(' ',offset-length(Str));
  1240.      Delete(Str,Offset,length(S1));
  1241.      Insert(S1,Str,Offset);
  1242.      end;
  1243.  
  1244.  
  1245. {section RightStr }
  1246. Function RightStr( St : string; l : integer ) : string;
  1247. var S : string;
  1248.      begin
  1249.      s := conststr(' ',L-length(St))+St;
  1250.      RightStr := copy(s,(length(s)-l)+1,l);
  1251.      end;
  1252.  
  1253.  
  1254. {section RJStr }
  1255. Function RJStr(s : string; w : byte) : string;
  1256.           {[STRING] Right justifies a string in a field of specified width }
  1257. var NewStr : string;
  1258.      begin
  1259.      NewStr := s;
  1260.      while length(NewStr) < w do
  1261.           insert(' ', NewStr, 1);
  1262.      RJStr := NewStr
  1263.      end;
  1264.  
  1265.  
  1266.  
  1267. {section  SameFile }
  1268. Function  SameFile(fn1,fn2 : string) : boolean;
  1269. var same : boolean;
  1270.     sr1, sr2 : searchrec;
  1271.      begin
  1272.      same := false;
  1273.      if (fileInfo(fn1,'',sr1) = 0) and
  1274.         (fileInfo(fn2,'',sr2) = 0) then
  1275.           begin
  1276.           if (sr1.size = sr2.size) and
  1277.              (sr1.time = sr2.time) and
  1278.              (sr1.name = sr2.name) then same := true;
  1279.           end;
  1280.      SameFile := same;
  1281.      end;
  1282.  
  1283.  
  1284. {section  SetDateBytes }
  1285. Procedure SetDateBytes(var yr,mo,dy : byte);
  1286. var year,month,day,doy : word;
  1287.      begin
  1288.      getdate(year,month,day,doy);
  1289.      yr := year-1900;
  1290.      mo := month;
  1291.      day := dy;
  1292.      end;
  1293.  
  1294.  
  1295. {section SizeofFile }
  1296. Function SizeofFile(fname : string; ext : string) : longint;
  1297. var l : longint;
  1298.     fn : string;
  1299.     SR : searchrec;
  1300.      begin
  1301.      fn := fname;
  1302.      l := 0;
  1303.      if ext <> '' then ForceExt(fn,ext);
  1304.      FindFirst(fn,anyfile,SR);
  1305.      if dosError = 0 then l := SR.size;
  1306.      SizeofFile := l;
  1307.      end;
  1308.  
  1309.  
  1310. {section  StrBool }
  1311. Function  StrBool (s : string) : boolean;
  1312. var x : boolean;
  1313.     s1 : string;
  1314.     code : integer;
  1315.      begin
  1316.      x := true;
  1317.      s1 := UpCaseStr(s);
  1318.      if (s1 = 'NO') or (s1 = 'OFF') then x := false;
  1319.      StrBool := x;
  1320.      end;
  1321.  
  1322.  
  1323. {section  StrCal }
  1324. Procedure StrCal(ds : string; var dd,mm,yy : integer);
  1325. var s,ss : string[8];
  1326.     i,l : word;
  1327.     err,defyear,defmonth,defday : word;
  1328.     begin
  1329.     s := ds;
  1330.     getdate(defyear,defmonth,defday,err);
  1331.     defyear := defyear mod 100;
  1332.     l := length(s);
  1333.     if l = 0 then
  1334.          begin
  1335.          dd := defday;
  1336.          mm := defmonth;
  1337.          yy := defyear;
  1338.          exit;
  1339.          end;
  1340.     for i := 1 to l do if s[i] = '-' then s[i] := '/';
  1341.     for i := 1 to l do
  1342.          if not (s[i] in ['0'..'9','/']) then s[i] := ' ';
  1343.     removeblanks(s);
  1344.     while length(s) <> 8 do
  1345.         begin
  1346.         if s[2] = '/' then
  1347.              begin
  1348.              s := '0' + s;
  1349.              l := length(s);
  1350.              end;
  1351.         case l of
  1352.             1..2   :  begin         { d,dd }
  1353.                       s := integerstr(defmonth,2) + '/' + s;
  1354.                       s := s + '/' + integerstr(defyear,2);
  1355.                       removeblanks(s);
  1356.                       end;
  1357.  
  1358.             3..5   :  begin  {m/d,mm/d,mm/dd - add year}
  1359.                       s := s + '/' + integerstr(defyear,2);
  1360.                       removeblanks(s);
  1361.                       end;
  1362.  
  1363.             7      :  begin   {mm/d/yy, mm/dd/y}
  1364.                       if      s[5] = '/' then insert('0',s,4)
  1365.                       else if s[6] = '/' then insert('0',s,6)
  1366.                       else s := '01/01/01';
  1367.                       end;
  1368.             8       : begin end;
  1369.  
  1370.             else s := '01/01/01';
  1371.             end;
  1372.         l := length(s);
  1373.         end;
  1374.     ss := copy(s,1,2);
  1375.     val(ss,mm,err);
  1376.     ss := copy(s,4,2);
  1377.     val(ss,dd,err);
  1378.     ss := copy(s,7,2);
  1379.     val(ss,yy,err);
  1380.     end;
  1381.  
  1382.  
  1383. {section  StrInt }
  1384. Function  StrInt(s : string) : integer;
  1385. var  x,err  : integer;
  1386.      begin
  1387.      x := 0;
  1388.      val(s,x,err);
  1389.      if err > 1 then val(copy(s,1,err-1),x,err);
  1390.      StrInt := x;
  1391.      end;
  1392.  
  1393.  
  1394. {section  StrLong }
  1395. Function  StrLong(s : string) : longint;
  1396. var  err  : integer;
  1397.      x    : longint;
  1398.      begin
  1399.      x := 0;
  1400.      val(s,x,err);
  1401.      if err > 1 then val(copy(s,1,err-1),x,err);
  1402.      StrLong := x;
  1403.      end;
  1404.  
  1405.  
  1406. {section  StrReal }
  1407. Function  StrReal(s : string) : real;
  1408. var  err  : integer;
  1409.      x    : real;
  1410.      begin
  1411.      x := 0;
  1412.      val(s,x,err);
  1413.      if err > 1 then val(copy(s,1,err-1),x,err);
  1414.      StrReal := x;
  1415.      end;
  1416.  
  1417.  
  1418. {section  SuggestExt }
  1419. Procedure SuggestExt(var fname : string; ext : string);
  1420.                         {[FILE] only if EXT not specified}
  1421. var i : integer;
  1422.     begin
  1423.     i := pos('.',fname);
  1424.     if (i = 0) or (i = length(fname)) then ForceExt(fname,ext);
  1425.     end;
  1426.  
  1427.  
  1428. {section TicksSinceMidnight }
  1429. Function TicksSinceMidnight : longint;
  1430. var hr,mn,sc,sc100 : word;
  1431.      begin
  1432.      GetTime(hr,mn,sc,sc100);
  1433.      TicksSinceMidnight := sc100 + (sc * onehundred) +
  1434.                                    (mn * 60 * onehundred) +
  1435.                                    (hr * 36 * tenthousand);
  1436.      end;
  1437.  
  1438.  
  1439. {section TicksToSecs }
  1440. Function TicksToSecs ( t : longint ) : real;
  1441.      begin
  1442.      TicksToSecs := t / 100.0;
  1443.      end;
  1444.  
  1445.  
  1446. {section TicksToSecsStr }
  1447. Function TicksToSecsStr ( t : longint ) : string;
  1448. var hr,mn,sc,tk : word;
  1449.     tx          : longint;
  1450.      begin
  1451.      mn := 0;     sc := 0;     tk := 0;
  1452.      tx := t;
  1453.      hr := word(tx div 360000);
  1454.      tx := tx -  (hr * 360000);
  1455.      if tx > 0 then
  1456.           begin
  1457.           mn := word(tx div 6000);
  1458.           tx := tx -  (mn * 6000);
  1459.           if tx > 0 then
  1460.                begin
  1461.                sc := word(tx div 100);
  1462.                tx := tx -  (sc * 100);
  1463.                end;
  1464.           tk := word(tx);
  1465.           end;
  1466.      TicksToSecsStr :=  FmtHMS(hr,mn,sc)+'.'+integerstr(tk+100,2);
  1467.      end;
  1468.  
  1469.  
  1470. {section  Trim }
  1471. Procedure Trim(var s : string);
  1472. var i : integer;
  1473.      begin
  1474.      RemoveTrailing(s,' ');
  1475.      RemoveLeading(s,' ');
  1476.      end;
  1477.  
  1478.  
  1479. {section TrimStr }
  1480. Function TrimStr(s : string) : string;
  1481. var s1 : string;
  1482.      begin
  1483.      s1 := s;
  1484.      trim(s1);
  1485.      TrimStr := s1;
  1486.      end;
  1487.  
  1488.  
  1489. {section UnCompressStr }
  1490. Function UnCompressStr(s : string) : string;
  1491. var ls,j,k,rc : integer;
  1492.     s2      : string;
  1493.     ch      : char;
  1494.     begin
  1495.     ls := length(s);
  1496.     s2 := '';
  1497.     j := 1;
  1498.     while j <= ls  do
  1499.         begin
  1500.         if (ord(s[j]) < (160+1)) then s2 := s2 + s[j]
  1501.         else
  1502.             begin
  1503.             ch := s[j-1];
  1504.             rc := ord(s[j]) - 160;
  1505.             for k := 1 to rc do s2 := s2 + ch;
  1506.             end;
  1507.         inc(j);
  1508.         end;
  1509.     UnCompressStr := s2;
  1510.     end;
  1511.  
  1512.  
  1513. {section  UnQT }
  1514. Function  UnQT(s : string) : string;    { removes quotes from around a string }
  1515. var s1 : string;
  1516.      begin
  1517.      s1 := s;
  1518.      if s1[1] = '''' then delete(s1,1,1);
  1519.      if s1[length(s1)] = '''' then delete(s1,length(s1),1);
  1520.      UnQT := s1;
  1521.      end;
  1522.  
  1523.  
  1524.  
  1525. {section UpCaseStr }
  1526. Function UpCaseStr(s : STRING) : string;
  1527. { Converts a string to upper case characters }
  1528. var i : integer;
  1529.      begin
  1530.      for i := 1 to length(s) do
  1531.          s[i] := UpCase(s[i]);
  1532.      UpCaseStr := s
  1533.      end;
  1534.  
  1535.  
  1536. {section VolumeLabel }
  1537. Function VolumeLabel( drive : string) : string;
  1538. var SR : searchrec;
  1539.      begin
  1540.      FindFirst(drive+'*.*',VolumeID,SR);
  1541.      if (DOSError = 0) then
  1542.           VolumeLabel := SR.Name
  1543.      else VolumeLabel := '';
  1544.      end;
  1545.